home *** CD-ROM | disk | FTP | other *** search
/ Macwelt 1 / Macwelt DVD 1.toast / Web-Publishing / HTML-Editoren / Alpha ƒ / Tcl / SystemCode / alphaHooks.tcl < prev    next >
Encoding:
Text File  |  2001-01-24  |  27.5 KB  |  894 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  AlphaTcl - core Tcl engine
  4.  # 
  5.  #  FILE: "alphaHooks.tcl"
  6.  #                                    created: 18/7/97 {5:10:18 pm} 
  7.  #                                last update: 01/24/2001 {11:47:41 AM} 
  8.  #  Author: Vince Darley
  9.  #  E-mail: <vince@santafe.edu>
  10.  #    mail: 317 Paseo de Peralta, Santa Fe, NM 87501
  11.  #     www: <http://www.santafe.edu/~vince/>
  12.  #  
  13.  # Copyright (c) 1997-2000  Vince Darley, all rights reserved
  14.  #  
  15.  # Description: 
  16.  #  
  17.  #  This file contains most of the Tcl procedures which are called
  18.  #  by Alpha/Alphatk internally.  As such you should be very careful
  19.  #  making any changes to these procedures.
  20.  #  
  21.  #  Here are the current hooks:
  22.  #  
  23.  #  activateHook changeMode closeHook deactivateHook modifyModeFlags 
  24.  #  quitHook resumeHook saveasHook saveHook savePostHook suspendHook
  25.  #  openHook
  26.  #  
  27.  #  There's also a 'mode::init' hook which will be called the first
  28.  #  time a mode is started up.  Note that the mode exists, but its
  29.  #  variables have not yet been made global, and its menus have not
  30.  #  yet been inserted into the menu bar.
  31.  #  
  32.  #  There's also a 'startupHook' which is called when Alpha starts
  33.  #  up, but after all other initialisation has taken place (before
  34.  #  any files are opened though).
  35.  #  
  36.  #  There's also a 'launch' hook for when an app is launched.
  37.  #  
  38.  #  If you wish to attach code to any of these procedures,
  39.  #  use hook::register.
  40.  #  
  41.  #  History
  42.  # 
  43.  #  modified by  rev reason
  44.  #  -------- --- --- -----------
  45.  #  18/7/97  VMD 1.0 original
  46.  #  22/7/97  VMD 1.1 fixed all bugs ;-) and added the above examples.
  47.  # ###################################################################
  48.  ##
  49.  
  50. namespace eval mode {}
  51. namespace eval win {}
  52.  
  53. lappend mode::procs carriageReturn OptionTitleBar OptionTitleBarSelect \
  54.   electricLeft electricRight electricSemi indentLine indentRegion \
  55.   parseFuncs MarkFile
  56.  
  57. proc saveHook name {
  58.     global win::Modes
  59.     hook::callAll saveHook [set win::Modes($name)] $name
  60. }
  61.  
  62. proc saveUnmodified {} {
  63.     set name [win::Current]
  64.     if {[file exists $name] || \
  65.       ([regsub { <[0-9]+>$} $name {} name] && [file exists $name])} {
  66.     getFileInfo $name arr
  67.     set mod $arr(modified)
  68.     save
  69.     setFileInfo $name modified $mod
  70.     return
  71.     }
  72.     # shouldn't really get here!
  73.     error "File doesn't exist"
  74. }
  75.  
  76. proc winChangeMode {name newMode} {
  77.     global win::Modes mode
  78.     set oldmode $mode
  79.     changeMode $newMode
  80.     set win::Modes($name) $newMode
  81.     refresh
  82. }
  83.  
  84. ## 
  85.  # -------------------------------------------------------------------------
  86.  # 
  87.  # "filePreOpeningHook" --
  88.  # 
  89.  #  Called by Alpha(tk)'s core inside things like 'edit' just before
  90.  #  we read in and open a file. 'name' is the name of the file on disk,
  91.  #  'winname' is the name of the window we will use (e.g. it may have
  92.  #  trailing <2>...)
  93.  #  
  94.  #  In Alpha 7 and Alpha 8 at present it is called in activateHook which
  95.  #  is a little too late.
  96.  # -------------------------------------------------------------------------
  97.  ##
  98. proc filePreOpeningHook {name winname} {
  99.     set m [file::preOpeningConfigurationCheck $name $winname]
  100.     if {![string length $m]} { set m [win::FindMode $name] }
  101.  
  102.     win::setInitialMode $winname $m
  103.     hook::callAll preOpeningHook $m $winname
  104.     return 0
  105. }
  106.  
  107. ## 
  108.  # -------------------------------------------------------------------------
  109.  # 
  110.  # "winCreatedHook" --
  111.  # 
  112.  #  Called by Alpha(tk)'s core as soon as the window structures are
  113.  #  created so that 'setWinInfo' can work.  In Alpha 7 and Alpha 8 at
  114.  #  present it is only called from openHook which is not early enough.
  115.  #  
  116.  #  Note that, in most respects, the window does not yet exist.
  117.  #  
  118.  #  This proc can be used to set any characteristics of the window
  119.  #  which we somehow determined were necessary while it was being
  120.  #  opened/created (e.g. mode-dependent values).
  121.  #  
  122.  # -------------------------------------------------------------------------
  123.  ##
  124. if {[info tclversion] < 8.0} {
  125.     proc winCreatedHook {winname} {
  126.     global win::config
  127.     if {[info exists win::config($winname)]} {
  128.         foreach opt [set win::config($winname)] {
  129.         if {([lindex $opt 0] == "tabsize") && (![winDirty])} {
  130.             catch [list eval setWinInfo $opt]
  131.             setWinInfo dirty 0
  132.         } else {
  133.             catch [list eval setWinInfo $opt]
  134.         }
  135.         }
  136.         unset win::config($winname)
  137.     }
  138.     }
  139. } else {
  140.     proc winCreatedHook {winname} {
  141.     global win::config
  142.     if {[info exists win::config($winname)]} {
  143.         foreach opt [set win::config($winname)] {
  144.         catch {eval [list setWinInfo -w $winname] $opt}
  145.         }
  146.         unset win::config($winname)
  147.     }
  148.     }
  149. }
  150.  
  151. ## 
  152.  # -------------------------------------------------------------------------
  153.  # 
  154.  # "changeMode" --
  155.  # 
  156.  #  A very important procedure.  It handles all switching from one mode
  157.  #  to another.  This means it has to adjust menus, floating windows,
  158.  #  global variables, mode prefs, and call a number of hooks.
  159.  #  
  160.  #  It maintains a list of variables which the new mode over-rides from
  161.  #  the global scope, and recreates them.  This allows a mode to have
  162.  #  its own value for a global variable without messing anything up.
  163.  # -------------------------------------------------------------------------
  164.  ##
  165. proc changeMode {newMode} {
  166.     global lastMode dummyProc mode seenMode PREFS global::_varMem \
  167.       global::features global::_oldTabSize \
  168.       alpha::changingMode
  169.     
  170.     # This section should restore any internally shadowed globals, 
  171.     # currently only tabSize may be stored by 'new'.  This code
  172.     # is only used for Alpha 7, and will be removed in the future.
  173.     if {[info exists global::_oldTabSize]} {
  174.     global tabSize
  175.     set tabSize [set global::_oldTabSize]
  176.     unset global::_oldTabSize
  177.     }
  178.     
  179.     set lastMode $mode
  180.     set mode $newMode
  181.     if {$lastMode == $mode} {
  182.         if {$newMode != ""} {
  183.         displayMode $newMode
  184.     }
  185.         return
  186.     }
  187.     if {$lastMode == ""} {
  188.     renameMenuItem -m Config "Mode Prefs" "${mode} Mode Prefs"
  189.     catch {menuEnableHook 1}
  190.     } elseif {$mode == ""} {
  191.     renameMenuItem -m Config "${lastMode} Mode Prefs" "Mode Prefs"
  192.     catch {menuEnableHook 0}
  193.     } else {
  194.     renameMenuItem -m Config "${lastMode} Mode Prefs" "${mode} Mode Prefs"
  195.     }
  196.     # Some code would like to know whether we're in the process
  197.     # of changing mode or not (e.g. complex package activation/deactivation
  198.     # sequences).
  199.     set alpha::changingMode 1
  200.     
  201.     # Get rid of all the old mode's variables, but only if it is necessary
  202.     # (Else we screw up traces on those variables)
  203.     global ${lastMode}modeVars
  204.     if {[info exists ${lastMode}modeVars]} {
  205.         foreach v [array names ${lastMode}modeVars] {
  206.         if {![info exists global::_varMem($v)]} {
  207.         global $v
  208.         catch {unset $v}
  209.         }
  210.         }
  211.     }
  212.     floatShowHide off $lastMode
  213.     if {[info exists global::_varMem]} {
  214.     foreach v [array names global::_varMem] {
  215.         global $v
  216.         set $v [set global::_varMem($v)]
  217.     }
  218.     unset global::_varMem
  219.     }
  220.     set onoff [package::onOrOff $mode $lastMode]
  221.     
  222.     eval package::deactivate [lindex $onoff 0]
  223.     
  224.     # These lines must load the mode vars into the mode var scope.
  225.     if {[info exists dummyProc($mode)]} { 
  226.     uplevel \#0 $dummyProc($mode) 
  227.     unset dummyProc($mode)
  228.     }
  229.     if {![info exists seenMode($mode)]} {
  230.     eval package::initialise [lindex $onoff 1]
  231.     hook::callAll mode::init $mode
  232.     }
  233.     # once the vars are in mode-var scope (= the <mode>modeVars array),
  234.     # they can be transfered to the global scope.  A future version of
  235.     # Alpha with Tcl8.0 namespaces may not need to do this.
  236.     global ${mode}modeVars
  237.     if {[info exists ${mode}modeVars]} {
  238.         foreach v [array names ${mode}modeVars] {
  239.             global $v
  240.         if {[info exists $v]} { 
  241.         set global::_varMem($v) [set $v]
  242.         }
  243.             set $v [set ${mode}modeVars($v)]
  244.         }
  245.     }
  246.     
  247.     eval package::activate [lindex $onoff 1]
  248.     floatShowHide on $mode
  249.  
  250.     if {![info exists seenMode($mode)]} {
  251.     global mode::procs
  252.     #foreach p ${mode::procs} {
  253.     #    if {[info commands ${mode}::${p}] == ""} {
  254.     #    auto_load ${mode}::${p}
  255.     #    }
  256.     #}
  257.     set seenMode($mode) 1
  258.     if {($mode != "") && [file exists [file join $PREFS ${mode}Prefs.tcl]]} {
  259.         if {[catch {uplevel \#0 [list source [file join $PREFS ${mode}Prefs.tcl]]}]} {
  260.                 alertnote "Your preferences file '${mode}Prefs.tcl has an error."
  261.             } 
  262.         }
  263.     }
  264.         
  265.     if {$newMode != ""} {
  266.     displayMode $newMode
  267.     }
  268.  
  269.     hook::callAll changeMode $mode $mode
  270.  
  271.     # Reset this.
  272.     set alpha::changingMode 0
  273. }
  274.  
  275. ## 
  276.  # -------------------------------------------------------------------------
  277.  # 
  278.  # "requireOpenWindowsHook" --
  279.  # 
  280.  #  En-/disable meaningless menu items which would require the presence
  281.  #  of a certain number of windows to be active
  282.  #  
  283.  #  This proc should only be called from 'openHook' and 'closeHook'.
  284.  #  
  285.  #  You can register with it using 
  286.  #  
  287.  #  'hook::register requireOpenWindowsHook [list menu item] N'
  288.  #  
  289.  #  where 'N' is the number of windows required (1 or 2 usually)
  290.  #  (and deregister etc using hook::deregister).
  291.  #  
  292.  #  We only really need the catch in here for two reasons:
  293.  #  (i) in case bad menus are registered accidentally
  294.  #  (ii) so startup errors can open a window without hitting another error
  295.  #  in the middle of doing that!
  296.  # -------------------------------------------------------------------------
  297.  ##
  298. proc requireOpenWindowsHook {requiredNum} {
  299.     global win::Active
  300.     set enable [expr {[llength [set win::Active]] >= $requiredNum ? 1 : 0}]
  301.     foreach i [hook::information requireOpenWindowsHook $requiredNum] {
  302.     catch "enableMenuItem $i $enable"
  303.     }
  304. }
  305.  
  306. ## 
  307.  # -------------------------------------------------------------------------
  308.  # 
  309.  # "menuEnableHook" --
  310.  # 
  311.  #  This hook is called to turn menu items on or off.  It is called 
  312.  #  whenever there are no windows, or when we go from 0->1 window.
  313.  #  
  314.  #  It should deal with all standard menus.  It does not deal with
  315.  #  special menu items like 'save', 'revert',.. which require more
  316.  #  information.
  317.  #  
  318.  #  It is called from changeMode.
  319.  #  
  320.  #  Andreas wrote most of this proc.
  321.  #  
  322.  #  Due to a deficiency in MacOS/MercutioMDEF/Alpha (not sure who
  323.  #  the culprit is!), key-bindings attached to menu items are still
  324.  #  triggered even if the menu item is inactive.
  325.  # -------------------------------------------------------------------------
  326.  ##
  327. proc menuEnableHook {{haveWin 1}} {
  328.     global winMenu mode
  329.     # we only get here if there are no windows, or 1 window which we
  330.     # just opened.  Otherwise nothing will be different to last time.
  331.     enableMenuItem File close $haveWin
  332.     enableMenuItem File closeAll $haveWin
  333.     enableMenuItem File closeFloat $haveWin
  334.     enableMenuItem File saveAs… $haveWin
  335.     enableMenuItem File saveACopyAs… $haveWin
  336.     if {[package::active printerChoicesMenu]} {
  337.     enableMenuItem File print $haveWin
  338.     } else {
  339.     enableMenuItem File print… $haveWin
  340.     }
  341.     enableMenuItem File printAll $haveWin
  342.     eval [lindex [list un {}] $haveWin]Bind 'p' <c> print
  343.  
  344.     if {[info tclversion] < 8.0} {
  345.     enableMenuItem Edit undo $haveWin
  346.     enableMenuItem Edit redo $haveWin
  347.     enableMenuItem Edit cut $haveWin
  348.     enableMenuItem Edit copy $haveWin
  349.     enableMenuItem Edit paste $haveWin
  350.     enableMenuItem Edit selectAll $haveWin
  351.     enableMenuItem Edit selectParagraph $haveWin
  352.     enableMenuItem Edit clear $haveWin
  353.     enableMenuItem Edit twiddle $haveWin
  354.     enableMenuItem Edit twiddleWords $haveWin
  355.     enableMenuItem Edit shiftLeft  $haveWin
  356.     enableMenuItem Edit shiftLeftSpace  $haveWin
  357.     enableMenuItem Edit shiftRight  $haveWin
  358.     enableMenuItem Edit shiftRightSpace  $haveWin
  359.     enableMenuItem Edit balance  $haveWin
  360.     
  361.         enableMenuItem Text fillParagraph $haveWin
  362.         enableMenuItem Text wrapParagraph $haveWin
  363.         enableMenuItem Text sentenceParagraph $haveWin
  364.         enableMenuItem Text fillRegion $haveWin
  365.         enableMenuItem Text wrapRegion $haveWin
  366.         enableMenuItem Text sentenceRegion $haveWin
  367.         enableMenuItem Text paragraphToLine $haveWin
  368.         enableMenuItem Text lineToParagraph $haveWin
  369.         enableMenuItem Text reverseSort $haveWin
  370.         enableMenuItem Text sortLines $haveWin
  371.         enableMenuItem Text sortParagraphs $haveWin
  372.         enableMenuItem Text zapInvisibles $haveWin
  373.         enableMenuItem Text tabsToSpaces $haveWin
  374.         enableMenuItem Text spacesToTabs $haveWin
  375.         enableMenuItem Text indentLine $haveWin
  376.         enableMenuItem Text indentSelection $haveWin
  377.         enableMenuItem Text upcaseRegion $haveWin
  378.         enableMenuItem Text downcaseRegion $haveWin
  379.         enableMenuItem Text strings $haveWin
  380.         enableMenuItem Text commentLine $haveWin
  381.         enableMenuItem Text uncommentLine $haveWin
  382.         enableMenuItem Text commentBox $haveWin
  383.         enableMenuItem Text uncommentBox $haveWin
  384.         enableMenuItem Text commentParagraph $haveWin
  385.         enableMenuItem Text uncommentParagraph $haveWin
  386.     enableMenuItem Config "Mode Prefs" $haveWin
  387.     enableMenuItem $winMenu zoom $haveWin
  388.     enableMenuItem $winMenu defaultSize $haveWin
  389.     enableMenuItem $winMenu chooseAWindow $haveWin
  390.     enableMenuItem $winMenu iconify $haveWin
  391.     enableMenuItem $winMenu arrange $haveWin
  392.     enableMenuItem $winMenu splitWindow $haveWin
  393.     enableMenuItem $winMenu toggleScrollbar $haveWin
  394.     
  395.     } else {
  396.     enableMenuItem Edit "" $haveWin
  397.     enableMenuItem Text "" $haveWin
  398.     enableMenuItem $winMenu "" $haveWin
  399.     if {$mode == ""} {
  400.         enableMenuItem -m Config "Mode Prefs" $haveWin
  401.     } else {
  402.         enableMenuItem -m Config "${mode} Mode Prefs" $haveWin
  403.     }
  404.     }
  405.     
  406.     enableMenuItem Search searchStart $haveWin
  407.     enableMenuItem Search findAgain $haveWin
  408.     enableMenuItem Search findAgainBackward $haveWin
  409.     if { ![string compare [searchString] ""] && !$haveWin } {
  410.     enableMenuItem Search findInNextFile $haveWin
  411.     } else {
  412.     enableMenuItem Search findInNextFile 1
  413.     }
  414.     enableMenuItem Search enterSearchString $haveWin
  415.     enableMenuItem Search enterReplaceString $haveWin
  416.     enableMenuItem Search quickFind $haveWin
  417.     enableMenuItem Search quickFindRegexp $haveWin
  418.     enableMenuItem Search reverseQuickFind $haveWin
  419.     enableMenuItem Search replace $haveWin
  420.     enableMenuItem Search replace&FindAgain $haveWin
  421.     enableMenuItem Search replaceAll $haveWin
  422.     enableMenuItem Search placeBookmark $haveWin
  423.     enableMenuItem Search returnToBookmark $haveWin
  424.     enableMenuItem Search gotoLine $haveWin
  425.     enableMenuItem Search matchingLines $haveWin
  426.     enableMenuItem Search gotoMatch $haveWin
  427.     enableMenuItem Search nextMatch $haveWin
  428.     enableMenuItem Search gotoFunc $haveWin
  429.     enableMenuItem Search gotoFileMark $haveWin
  430.     enableMenuItem Search markHilite $haveWin
  431.     enableMenuItem Search namedMarks $haveWin
  432.     enableMenuItem Search unnamedMarks $haveWin
  433.     
  434.     enableMenuItem Utils AsciiEtc $haveWin
  435.     enableMenuItem Utils cmdDoubleClick $haveWin
  436.     enableMenuItem Utils winUtils $haveWin
  437.     enableMenuItem Utils spellcheckWindow $haveWin
  438.     enableMenuItem Utils spellcheckSelection $haveWin
  439.     enableMenuItem Utils wordCount $haveWin
  440.     
  441.     enableMenuItem Config setFontsTabs… $haveWin
  442.     
  443.     if {!$haveWin} {
  444.     enableMenuItem File save 0
  445.     enableMenuItem File saveUnmodified 0
  446.     enableMenuItem File revert 0
  447.     enableMenuItem File renameTo… 0
  448.     enableMenuItem File saveAll 0
  449.     }
  450.     
  451.     requireOpenWindowsHook 1
  452. }
  453.  
  454. proc savePostHook name {
  455.     # So modified date is ok
  456.     if {([file exists $name] && (![catch {getFileInfo $name info}])) || \
  457.       ([regsub { <[0-9]+>$} $name {} nm] && [file exists $nm] \
  458.       && (![catch {getFileInfo $nm info}]))} {
  459.     global win::Modified
  460.     set win::Modified($name) $info(modified)
  461.     } else {
  462.     if {[info tclversion] < 8.0} {
  463.         # Alpha bug workaround
  464.         set name [subst $name]
  465.         if {([file exists $name] && (![catch {getFileInfo $name info}])) || \
  466.           ([regsub { <[0-9]+>$} $name {} nm] && [file exists $nm] \
  467.           && (![catch {getFileInfo $nm info}]))} {
  468.         global win::Modified
  469.         set win::Modified($name) $info(modified)
  470.         } else {
  471.         alertnote "Weird, file '$name' doesn't seem to exist: please\
  472.           report the circumstances of this problem to the Alpha-D mailing list."
  473.         }
  474.     } else {
  475.         alertnote "Weird, file '$name' doesn't seem to exist: please\
  476.           report the circumstances of this problem to the Alpha-D mailing list."
  477.     }
  478.     }
  479.     hook::callAll savePostHook "" $name
  480. }
  481.  
  482. proc closeHook name {
  483.     global markStack win::Modes win::Active win::Current win::Dirty \
  484.       win::NumDirty win::Modified
  485.     hook::callAll closeHook [set win::Modes($name)] $name
  486.  
  487.     if {[info exists win::Dirty($name)]} {
  488.     incr win::NumDirty -1
  489.     unset win::Dirty($name)
  490.     enableMenuItem File saveAll [expr {${win::NumDirty} ? 1 : 0}]
  491.     }
  492.         
  493.     unset win::Modes($name)
  494.     if {[info exists win::Modified($name)]} {
  495.     unset win::Modified($name)
  496.     }
  497.     
  498.     if {[llength $markStack]} {
  499.         set markStack [lremove -glob $markStack $name*]
  500.     }
  501.     win::removeFromMenu $name
  502.  
  503.     if {[set ind [lsearch -exact ${win::Active} $name]] >= 0} {
  504.         set win::Active [lreplace ${win::Active} $ind $ind]
  505.     }
  506.     if {![llength [winNames]]} {
  507.     set win::Current ""
  508.     changeMode {}
  509.     }
  510.     requireOpenWindowsHook 2
  511. }
  512.  
  513. proc deactivateHook name {
  514.     hook::callAll deactivateHook "" $name
  515. }
  516.  
  517. proc suspendHook name {
  518.     hook::callAll suspendHook "" $name
  519. }
  520.  
  521. ## 
  522.  # -------------------------------------------------------------------------
  523.  # 
  524.  # "resumeHook" --
  525.  # 
  526.  #  The parameter 'name' is not used, so please ignore it.
  527.  # -------------------------------------------------------------------------
  528.  ##
  529. proc resumeHook {name} {
  530.     # Check if the foremost window needs to be have its modified
  531.     # status adjusted, and calls all resumeHooks with the 
  532.     # modified status (1 or 0) as an extra argument.
  533.     
  534.     hook::callAll resumeHook ""
  535.     
  536.     global win::Active
  537.     foreach win [set win::Active] {
  538.     hook::callAll resumeModifiedHook $win $win [modifiedCheck $win]
  539.     }
  540. }
  541.  
  542. ## 
  543.  # -------------------------------------------------------------------------
  544.  # 
  545.  # "modifiedCheck" --
  546.  # 
  547.  #  Check whether $name has been modified on disk, and ensure that the
  548.  #  save and revert menu items are correctly dimmed (if this is the front-
  549.  #  most window).
  550.  #  
  551.  #  Returns 1 if the window has been modified on disk since last save.
  552.  # -------------------------------------------------------------------------
  553.  ##
  554. proc modifiedCheck {name} {
  555.     if {([file exists $name] && (![catch {getFileInfo $name info}])) || \
  556.       ([regsub { <[0-9]+>$} $name {} nm] && [file exists $nm] \
  557.       && (![catch {getFileInfo $nm info}]))} {
  558.     set ret 0
  559.     if {[catch {getWinInfo -w $name arr}]} {
  560.         set mod 0
  561.     } else {
  562.         set dirty $arr(dirty)
  563.         if {!$dirty} {
  564.         global win::Modified
  565.         set mod [expr {[set win::Modified($name)] < $info(modified)}]
  566.         if {$mod} { 
  567.             diskModifiedHook $name
  568.             set ret 1
  569.         }
  570.         } else {
  571.         set mod 1
  572.         }
  573.     }
  574.     if {$name == [win::Current]} {
  575.         enableMenuItem File save $mod
  576.         enableMenuItem File revert $mod
  577.     }
  578.     return $ret
  579.     }
  580.     return 0
  581. }
  582.  
  583. proc diskModifiedHook {name {mod 1}} {
  584.     if {$mod} {
  585.     message "File has changed on disk since last save."
  586.     hook::callAll diskModifiedHook 1 $name 1
  587.     } else {
  588.     # Unmodified (i.e. reverted)
  589.     hook::callAll diskModifiedHook 0 $name 0
  590.     }
  591. }
  592.  
  593. ## 
  594.  # -------------------------------------------------------------------------
  595.  # 
  596.  # "saveasHook" --
  597.  # 
  598.  #  Called when saving a window which doesn't yet exist as a file
  599.  #  (in particular 'Untitled' windows) or when the user selects
  600.  #  saveAs.
  601.  # -------------------------------------------------------------------------
  602.  ##
  603. proc saveasHook {oldName newName} {
  604.     global win::Modes win::Active win::Current win::Modified
  605.     if {$oldName == $newName} return
  606.     win::removeFromMenu $oldName
  607.     win::addToMenu $newName
  608.     win::setMode $newName
  609.     changeMode [set win::Modes($newName)]
  610.     
  611.     if {[set ind [lsearch -exact ${win::Active} $oldName]] >= 0} {
  612.     set win::Active [linsert [lreplace ${win::Active} $ind $ind] 0 $newName]
  613.     } else {
  614.     # hmmm! this is bad.  The old window has gone!
  615.     set win::Active [linsert ${win::Active} 0 $newName]
  616.     }
  617.     
  618.     set win::Current $newName
  619.     if {[info exists win::Modes($oldName)]} {
  620.     unset win::Modes($oldName)
  621.     }
  622.     if {[info exists win::Modified($oldName)]} {
  623.     unset win::Modified($oldName)
  624.     }
  625.  
  626.     hook::callAll saveasHook [set win::Modes($newName)] $oldName $newName
  627.     refresh
  628. }
  629.  
  630. if {0 && [info tclversion] < 8.0} {
  631.     hook::register saveasHook callSavePostHook *
  632.     proc callSavePostHook {old new} {
  633.     savePostHook $new
  634.     }
  635. }
  636.  
  637. ## 
  638.  # -------------------------------------------------------------------------
  639.  # 
  640.  # "saveACopyAs" --
  641.  # 
  642.  # (This proc actually has nothing to do with hooks, but seemed to fit here)
  643.  # -------------------------------------------------------------------------
  644.  ##
  645. proc saveACopyAs {} {
  646.     if {[file exists [set nm [win::StripCount [win::Current]]]]} {
  647.     global alpha::platform
  648.     if {${alpha::platform} == "alpha"} {
  649.         set nm2 [putfile "Save a copy as:" [file tail $nm]]
  650.     } else {
  651.         set nm2 [putfile "Save a copy as:" $nm]
  652.     }
  653.     if {[string length $nm2]} {
  654.         if {[file exists $nm2]} {file delete $nm2}
  655.         file copy $nm $nm2
  656.     }
  657.     }
  658. }
  659.  
  660. ensureset win::Active ""
  661.  
  662. proc activateHook {name} {
  663.     global win::Modes win::Active win::Current win::Modified alpha::platform
  664.     
  665.     # if the file exists (this seems to be the quickest way to check)
  666.     set isfile [expr {[file exists $name] || \
  667.       ([regsub { <[0-9]+>$} $name {} nm] && [file exists $nm])}]
  668.  
  669.     if {![info exists win::Modes($name)]} {
  670.     # Ideally this should happen internal to Alpha when a file-window
  671.     # is opened.  These calls check the actual contents of the file
  672.     # (the first few lines) to see whether a particular tabsize, encoding,
  673.     # mode, etc are specified.
  674.     if {${alpha::platform} == "alpha"} {
  675.         if {$isfile} {
  676.         if {[info exists nm]} {
  677.             filePreOpeningHook $nm $name
  678.         } else {
  679.             filePreOpeningHook $name $name
  680.         }
  681.         }
  682.     }
  683.     if {![info exists win::Modes($name)]} {
  684.         win::setMode $name
  685.     }
  686.     }
  687.     if {[set ind [lsearch -exact ${win::Active} $name]] == -1} {
  688.     set win::Active [linsert ${win::Active} 0 $name]
  689.     } elseif {$ind >= 1} {
  690.     set win::Active [linsert [lreplace ${win::Active} $ind $ind] 0 $name]
  691.     }
  692.     set win::Current $name
  693.     
  694.     changeMode [set win::Modes($name)]
  695.     
  696.     hook::callAll activateHook [set win::Modes($name)] $name
  697.  
  698.     # This fails if the window is just opening, but then we know it's clean
  699.     # (on Alpha 8/Tk it doesn't fail).
  700.     if {[catchNoClobber {getWinInfo -w $name arr}]} {
  701.     set dirty 0
  702.     set mod 0
  703.     } else {
  704.     set dirty $arr(dirty)
  705.     }
  706.     
  707.     if {$isfile} {
  708.     if {!$dirty} {
  709.         if {![info exists mod]} {
  710.         if {[info exists win::Modified($name)]} {
  711.             if {[info exists nm]} {
  712.             getFileInfo $nm modarr
  713.             } else {
  714.             getFileInfo $name modarr
  715.             }
  716.             set mod [expr {[set win::Modified($name)] < $modarr(modified)}]
  717.             if {$mod} { 
  718.             diskModifiedHook $name
  719.             }
  720.         } else {
  721.             set mod 0
  722.         }
  723.         }
  724.     } else {
  725.         set mod 1
  726.     }
  727.     enableMenuItem File save $mod
  728.     enableMenuItem File saveUnmodified $dirty
  729.     enableMenuItem File revert $mod
  730.     enableMenuItem File renameTo… 1
  731.     } else {
  732.     if {${alpha::platform} == "alpha"} {
  733.         # On Alphatk this prevents save acting as save-as when the 
  734.         # window has never been saved.
  735.         enableMenuItem File save 0
  736.     } else {
  737.         enableMenuItem File save 1
  738.     }
  739.     enableMenuItem File saveUnmodified 0
  740.     enableMenuItem File revert 0
  741.     enableMenuItem File renameTo… 0
  742.     }
  743.     enableMenuItem Edit undo $dirty
  744. }
  745.  
  746. proc quitHook {} {
  747.     global alpha::tracingChannel
  748.     catch {close ${alpha::tracingChannel}}
  749.     prefs::saveModified
  750.     hook::callAll quitHook
  751. }
  752.  
  753. ## 
  754.  # -------------------------------------------------------------------------
  755.  # 
  756.  # "dirtyHook" --
  757.  # 
  758.  #  This proc currently has to keep track in the array 'win::Dirty' of
  759.  #  the dirty status of windows.  Its only use is if we close a dirty
  760.  #  window and select 'discard', we would otherwise have a faulty
  761.  #  'win::NumDirty' count.  If there's a different solution we should
  762.  #  get rid of the win::Dirty array.
  763.  #  
  764.  #  Note: closeHook is called after the window is gone, and killWindow
  765.  #  isn't called if you click in the close-box, so they don't solve
  766.  #  the problem.
  767.  # -------------------------------------------------------------------------
  768.  ##
  769. proc dirtyHook {name dirty} {
  770.     global winMenu win::NumDirty win::Dirty
  771.     markMenuItem -m $winMenu [file tail $name] $dirty "◊"
  772.     if {$dirty == "on" || $dirty == 1} {
  773.     set win::Dirty($name) 1
  774.     incr win::NumDirty 1
  775.     } else {
  776.     if {[info exists win::Dirty($name)]} {
  777.         unset win::Dirty($name)
  778.     }
  779.     incr win::NumDirty -1
  780.     }
  781.     enableMenuItem File save $dirty
  782.     enableMenuItem File saveUnmodified $dirty
  783.     enableMenuItem File revert $dirty
  784.     enableMenuItem File saveAll [expr {${win::NumDirty} ? 1 : 0}]
  785.     enableMenuItem Edit undo $dirty
  786. }
  787.  
  788. proc openHook {name} {
  789.     global win::Modes autoMark mode screenHeight screenWidth \
  790.       forceMainScreen win::Modified PREFS
  791.  
  792.     changeMode [set win::Modes($name)]
  793.     win::addToMenu $name
  794.     message ""
  795.  
  796.     if {[info tclversion] < 8.0} {
  797.     # This should be called much earlier in Alpha 8/tk
  798.     winCreatedHook $name
  799.     }
  800.     
  801.     if {([file exists $name] && (![catch {getFileInfo $name info}])) || \
  802.       ([regsub { <[0-9]+>$} $name {} nm] && [file exists $nm] \
  803.       && (![catch {getFileInfo $nm info}]))} {
  804.         if {[info exists info(creator)] && ($info(creator) == {ttxt})} {
  805.             setWinInfo dirty 0
  806.         }
  807.         if {[info exists info(type)] && ($info(type) == {ttro})} {
  808.             catch {setWinInfo read-only 1}
  809.             message "Read-only!"
  810.         }
  811.     set win::Modified($name) $info(modified)
  812.     }
  813.     
  814.     global ${mode}modeVars
  815.     
  816.     if {$forceMainScreen} {
  817.         set geo [getGeometry]
  818.         set l [lindex $geo 0]; set t [lindex $geo 1]; set w [lindex $geo 2]; set h [lindex $geo 3]; 
  819.         if {($l < 0) || ($t < 35) || ([expr {$l + $w}] > $screenWidth) || ([expr {$t + $h + 18}] > $screenHeight)} {
  820.         defaultSize
  821.         }
  822.     }
  823.     getWinInfo arr
  824.     if {!$arr(read-only)} {
  825.     if {[info exists ${mode}modeVars(autoMark)] \
  826.       && [set ${mode}modeVars(autoMark)] \
  827.       && ![llength [getNamedMarks -n]]} {
  828.         markFile
  829.     }
  830.     }
  831.     
  832.     if {[string match "${PREFS}*defs.tcl" $name]} {setWinInfo read-only 1}
  833.     
  834.     requireOpenWindowsHook 2
  835.     
  836.     hook::callAll openHook [set win::Modes($name)] $name
  837. }
  838.  
  839. ## 
  840.  # -------------------------------------------------------------------------
  841.  # 
  842.  # "fileMovedHook" --
  843.  # 
  844.  #  Called by Alpha when a window's file has been moved behind our back.
  845.  #  (Only for Alpha using Tcl 8.0)
  846.  # -------------------------------------------------------------------------
  847.  ##
  848. proc fileMovedHook {from to} {
  849.     global win::Active winNumToName winNameToNum win::Modes win::Modified
  850.     if {[info exists winNameToNum($from)]} {
  851.     set i $winNameToNum($from)
  852.     unset winNameToNum($from)
  853.     set winNumToName($i) $to
  854.     set winNameToNum($to) $i
  855.     } else {
  856.     alertnote "Can't find old window.  Bad error."
  857.     }
  858.     set win::Modes($to) [set win::Modes($from)]
  859.     set win::Modified($to) [set win::Modified($from)]
  860.     unset win::Modes($from)
  861.     unset win::Modified($from)
  862.     set idx [lsearch -exact ${win::Active} $from]
  863.     if {$idx >= 0} {
  864.     set win::Active [lreplace ${win::Active} $idx $idx $to]
  865.     } else {
  866.     alertnote "Can't find the old window! Bad error in fileMovedHook."
  867.     }
  868.     hook::callAll fileMovedHook $from $to
  869. }
  870.  
  871. proc changeTextHook {name} {
  872.     global win::Modes
  873.     hook::callAll changeTextHook [set win::Modes($name)] $name
  874. }
  875.  
  876. proc revertHook {name} {
  877.     global win::Modified
  878.     if {([file exists $name] && (![catch {getFileInfo $name info}])) || \
  879.       ([regsub { <[0-9]+>$} $name {} nm] && [file exists $nm] \
  880.       && (![catch {getFileInfo $nm info}]))} {
  881.     set win::Modified($name) $info(modified)
  882.     diskModifiedHook $name 0
  883.     }
  884.     enableMenuItem File save 0
  885.     enableMenuItem File revert 0
  886. }
  887.  
  888.  
  889.  
  890.  
  891.  
  892.  
  893.  
  894.